{
Traviesadora beta 0.2.0.13.33 (30.11.2008)
LastMod: 20.03.2009 by Prof1983

Copyright 2008, travieorama@googlemail.com

This file is part of the taviesadora project

taviesadora is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

taviesadora is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
}
unit ChatDistributer;

interface

uses
  Forms, Classes, SysUtils, Windows, ChatController, XmlTag, EntityCache,
  JabberMsg, JabberConst, JabberSession, InetCommunication,
  Entity, JabberID, RosterDB, Dialogs, Service, RosterGlobals;

const
  sep = '~|';
  INGNORE_PRESENCE_AFTER_OFFLINEMSG_TIME = 500;

type
  TRegCallBackItem = record
    Obj: TObject;
    TXPrefix: string;
    RXPrefix: string;
    AcceptRemote: Boolean;
  end;
  PRegCallBackItem = ^TRegCallBackItem;
  TAcceptanceAction = (aaNone,aaMovie,aaVib);
  PAcceptanceAction = ^TAcceptanceAction;
  TCryptState = (csNoEncryption,csInitialising,csWeak,csWaitingForQues,csAuthenticated,csChangingKey);

  TChatDistri = class
  private
    _ObjList: TList;
    _owner: TComponent;
    initiator: Boolean;
    InetCom: TInetCom;
    _RosterDB: TRosterDB;
    _receivedXIMNode: Boolean; //true if we have received a xhtml-im message
    _receivedMessage: Boolean; //true if we have received at least one message
    _supportsXIM: Boolean;     //true if caps advertises support
    _reply_id: string;
    _resource: string;
    _UserID: string;
    _rmtNick: string;
    _MyName: string;
    _sent_composing: Boolean;
    _send_composing: Boolean;
    _check_event: Boolean;
    _flash_ticks: Integer;
    _lastOfflineMsgRxed: Cardinal;
    ProtocollIsReady: Boolean;
    CryptState: TCryptState;
    function SearchForWin(obj: TObject): Integer;
    function SearchForRXPrefix(RXPrefix: string): Integer;
    function SearchForTXPrefix(TXPrefix: string): Integer;
    procedure MessageEvent(tag: TXMLTag);
    procedure SendMessageEvent(tag: TXMLTag);
    function GetThread(): WideString;
    procedure SendRawMessage(body, subject, xml: Widestring; fire_plugins: Boolean; Priority: PriorityType);
    function _sendMsg(txt: WideString; xml: WideString; Priority: PriorityType): Boolean;
    function RegisterMsgCallBack(AcceptRemote: Boolean; RXPrefix, TXPrefix: string; Frm: TObject): TObject;
  public
    chat_object: TChatController;
  public
    constructor Create(Chat: TChatController; InetCom: TInetCom; MyName, UserID, Resource: string; AsInitiator: Boolean; ContactState: TContactState);
    destructor Destroy; override;
    procedure AskForPlayingVibViaChatWin;
    function NewChat:TForm;
    function NewVibTX(AcceptRemote:boolean):TObject;
    procedure NewIncomingChatMsg(Msg:string);
    function AskForPlayingVib(VibDistri:TObject):TObject;
    function NewMovie(AcceptRemote:boolean):TForm;
    procedure AskForWatchingMovie(MovieWin:TForm);
    procedure MovieAccepted(MovieWin:TForm);
    procedure VibAccepted;
    procedure VibDenied;
    procedure SetAcceptRemote(AcceptRemote:boolean;Obj:TObject);
    function isWaitingForVibRXAnswer:boolean;
    procedure MovieDenied();
    function GetRosterDB(): TRosterDB;
    procedure UnRegisterMsgCallback(Obj: TObject);
    procedure SendMessage(Msg: string; Sender: TObject);
    procedure DistriMsg(Msg: string; OfflineMsg: Boolean);
    procedure sendComposing(id, jid: Widestring);
    procedure SetUserID(UserID: string);
    function GetUserID: string;
    function GetUserIDwoPortNum: string;
    procedure SetNewContactState(jid: string; NewContactState, OldContactState: TContactState);
    procedure SetRmtNick(RmtNick: string);
    procedure PlayQueue();
    function GetNetType: TNetType;
    function GetRmtNick: string;
    function PartnerCanEncryption: Boolean;
    function PartnerIsOnline: Boolean;
    procedure ProtocollIsReadyForTransferMsgs();
    procedure SetCryptState(CryptState: TCryptState);
    function GetCryptState(): TCryptState;
    procedure SetToWantedCrypt(CryptState: TCryptState);
  end;

function GetPrefix(Msg: string): string;

implementation

uses
  {Movie,} ChatWin, Popup, {VibDistributer, VibWinFunction,} Jabber, NobraProtocoll, PrefController,
  TraviesadoraCoreImpl;

function GetPrefix(Msg: string): string;
begin
  result := '';
  if (Pos('{',msg) > 0) then
  begin
    Delete(msg,1,pos('{',msg));
    Delete(msg,pos('}',msg), Length(msg));
    Result := LowerCase(msg);
  end;
end;

{ TChatDistri }

constructor TChatDistri.Create(Chat: TChatController; InetCom: TInetCom;
  MyName, UserID, Resource: string; AsInitiator: Boolean; ContactState: TContactState);
begin
  inherited Create;
  _MyName := MyName;
  _ObjList := TList.Create;
  self.InetCom := InetCom;
  ProtocollIsReady := False;
  _lastOfflineMsgRxed := 0;
  _resource := Resource;
  CryptState := csNoEncryption;
  _RosterDB := InetCom.GetRosterDB;
  _supportsXIM := False;
  _reply_id := '';
  _check_event := False;
  _receivedMessage := False;
  _receivedXIMNode := False;
  chat_object := Chat;
  initiator := AsInitiator;
  if Assigned(chat_object) then
  begin
    chat_object.OnMessage := MessageEvent;
    chat_object.OnSendMessage := SendMessageEvent;
  end;
  SetUserID(UserID);
  if InetCom is TJabber then
  begin
    ProtocollIsReadyForTransferMsgs;
  end;
end;

destructor TChatDistri.Destroy;
var
  i: Integer;
  c: Integer;
  cbItem: PRegCallBackItem;
begin
  if Assigned(TravCore.CryptLayer) then
    TravCore.CryptLayer.UnRegisterChatDistri(Self);
  while (_ObjList.Count > 0) do
  begin
    i := _ObjList.Count;
    cbItem := _ObjList[0];
    if Assigned(cbItem.Obj) then
    begin
      try
      if cbItem.Obj is TFrmChat then
        (cbItem.obj as TFrmChat).ChatDistriDestroyed
      {
      else if cbItem.Obj is TfrmMovie then
        (cbItem.obj as TfrmMovie).ChatDistriDestroyed
      }
      else if cbItem.Obj is TForm then
        (cbItem.obj as TForm).Close
      {
      else if cbItem.Obj is TVibDistri then
        (cbItem.obj as TVibDistri).Destroy
      else if cbItem.Obj is TVibFunction then
        (cbItem.obj as TVibFunction).ChatDistriDestroyed
      }
      else
      begin
        i := -_ObjList.Count;
        cbItem.obj.Destroy;
        dispose(cbItem);
        _ObjList.Delete(0);
      end;
      if i = _ObjList.Count then
      begin
        application.ProcessMessages;
      end;
      except
        on EAccessViolation do
        begin
          dispose(cbItem);
          _ObjList.Delete(0);
        end;
      end;
    end else begin
      dispose(cbItem);
      _ObjList.Delete(0);
    end;
  end;
 _RosterDB.UnRegisterCallBackChat(self);
  _ObjList.Clear;
  if InetCom is Tjabber then
    (InetCom as Tjabber).UnregisterChatDistri(_UserID,_resource);
  _ObjList.Free;
  if chat_object <> nil then begin
    chat_object.OnMessage := nil;
    chat_object.OnSendMessage := nil;
  end;
  inherited destroy;
end;

procedure TChatDistri.SetNewContactState(jid: string; NewContactState, OldContactState: TContactState);
var
  i:integer;
  cbItem:PRegCallBackItem;
  itsMe:boolean;
begin
  if (NewContactState = csOffline) and (OldContactState <> csOffline) then
  begin
    i := 0;
    while i < _ObjList.Count do
    begin
      cbItem := _ObjList[i];
      if cbItem.Obj is TFrmChat then
      begin
        (cbItem.obj as TFrmChat).ClearAskingAcception;
      end;
      {
      else if cbItem.Obj is TfrmMovie then
      begin
        (cbItem.obj as TfrmMovie).SetToSingleWatcher;
      end
      }
      {
      else if cbItem.Obj is TVibDistri then begin
        (cbItem.obj as TVibDistri).destroy;
        dec(i); //a destroy does a unregister so its deleted aswell from this list and another item has this index
      end
      else if cbItem.Obj is TVibFunction then begin
        (cbItem.obj as TVibFunction).destroy;
        dec(i);
      end;
      }
      inc(i);
    end;
    if jid = '' then
    begin //if its me who got offline this
      destroy;
    end
    else
    begin
      TravCore.CryptLayer.UnRegisterChatDistri(self);
      SetCryptState(csNoEncryption);
    end;
    //ProtocollIsReady := false;
  end else if (OldContactState = csOffline) and (NewContactState <> csOffline) then begin
    if (_lastOfflineMsgRxed = 0)or((_lastOfflineMsgRxed <> 0) and(GetTickCount-_lastOfflineMsgRxed > INGNORE_PRESENCE_AFTER_OFFLINEMSG_TIME)) then
    begin
      initiator := jid <> '';
      if ProtocollIsReady then
        if Assigned(TravCore.CryptLayer) then
          TravCore.CryptLayer.RegisterChatDistri(Self, Initiator);
    end;
  end;
end;

procedure TChatDistri.SetUserID(UserID: string);
var
  i:integer;
  cbItem:PRegCallBackItem;
begin
  if _UserID <> UserID then begin
    _RosterDB.UnRegisterCallBackChat(self);
    _UserID := UserID;
    _RosterDB.RegisterCallBackChat(self,UserID);
    _RosterDB.RegisterCallBackChat(self,'');
    for i := 0 to _ObjList.Count-1 do begin
      cbItem := _ObjList[i];
      if cbItem.Obj is TFrmChat then begin
        (cbItem.obj as TFrmChat).SetJID(UserID);       
      end;
    end;
  end;
end;

procedure TChatDistri.SetRmtNick(RmtNick: string);
var
  i:integer;
  cbItem:PRegCallBackItem;
begin
  _rmtNick := RmtNick;
  for i := 0 to _ObjList.Count-1 do begin
    cbItem := _ObjList[i];
    if cbItem.Obj is TFrmChat then begin
      (cbItem.obj as TFrmChat).SetRmtNick(RmtNick);
    end;
  end;
end;

function TChatDistri.SearchForWin(obj: TObject): Integer;
var
  i:integer;
  cbItem:PRegCallBackItem;
begin
  result := -1;
  for i := 0 to _ObjList.Count-1 do
  begin
    cbItem := _ObjList[i];
    if cbItem.Obj = obj then
    begin
      Result := i;
      Break;
    end;
  end;
end;

function TChatDistri.SearchForRXPrefix(RXPrefix: string): Integer;
var
  i: Integer;
  cbItem: PRegCallBackItem;
begin
  result := -1;
  RXPrefix := lowercase(RXPrefix);
  for i := 0 to _ObjList.Count-1 do
  begin
    cbItem := _ObjList[i];
    if cbItem.RXPrefix = RXPrefix then
    begin
      Result := i;
      Break;
    end;
  end;
end;

function TChatDistri.SearchForTxPrefix(TXPrefix: string): Integer;
var
  i:integer;
  cbItem:PRegCallBackItem;
begin
  result := -1;
  TXPrefix := lowercase(TXPrefix);
  for i := 0 to _ObjList.Count-1 do
  begin
    cbItem := _ObjList[i];
    if cbItem.TXPrefix = TXPrefix then
    begin
      Result := i;
      Break;
    end;
  end;
end;

procedure TChatDistri.DistriMsg(Msg: string; OfflineMsg: Boolean);
var
  Prefix,Prefix2,s,s1:string;
  i,n:integer;
  cbItem:PRegCallBackItem;
  found:boolean;
  frm:TForm;
  stoken:TStringTokenizer;
  msgnumber:integer;
begin
  found := false;
  if OfflineMsg then
  _lastOfflineMsgRxed := GetTickCount;
  if Assigned(TravCore.CryptLayer) and not(OfflineMsg) then
    msg := TravCore.CryptLayer.NewInMessage(msg, Self);
  if (msg = '') then Exit;
  if (Pos(#13,msg) > 0) then
    Delete(msg, Pos(#0,msg), Length(msg));
  stoken := TStringTokenizer.Create(msg);
  try
    if InetCom is TNobraNet then
      stoken.SetTrenner(#$D#$A)
    else
      stoken.SetTrenner('');
    msgnumber := 0;
    while stoken.StillAToken do
    begin
      Inc(msgnumber);
      if (msgNumber > 10) then
        break;
      msg := stoken.NextToken;
      if InetCom is TNobraNet then
      begin
        msg := TranslateNobraToTravie(msg);
      end;
      Prefix := GetPrefix(msg);
      if (Prefix <> '') then
        Delete(msg, 1, Length(Prefix)+2);
      Prefix2 := Prefix;
      if (OfflineMsg) and (prefix <> '') and (prefix <> 'chat') then   //If its an offline msg ignore other msg than chat!
        continue;
      if (Prefix = 'askmovie') then
      begin
        {
        frm := MovieSingleWatcher.GetFirstWin(true);
        if frm = nil then begin
          if SearchForRXPrefix('movie') = -1 then
            Prefix2 := 'chat'
          else
            Prefix2 := 'movie';
        end else begin
          Prefix2 := 'movie';
          if SearchForRXPrefix('movie') = -1 then begin
            RegisterMsgCallBack(true,'movie','movie',frm);
            (frm as TfrmMovie).SetChatDistributor(self);
          end;
        end;
        }
      end
      else if Prefix = 'askvib' then
      begin
        Prefix2 := 'chat';
      end
      else if Prefix = 'movie_question_stopped' then
      begin
        Prefix2 := 'chat';
      end
      else if Prefix = 'vib_question_stopped' then
      begin
        Prefix2 := 'chat';
      end;
      s1 := Prefix2;
      if s1 = 'chat' then
        s1 := '';
      i := 0;
      while i < _ObjList.Count do begin
      //for i := 0 to _ObjList.Count-1 do begin
        n := _ObjList.Count;
        cbItem := _ObjList[i];
        s:=lowercase(cbItem.RXPrefix);
        if s = 'chat' then
          s := '';
        if s= s1 then begin
          found := true;
          if cbItem.Obj is TFrmChat then begin
            if Prefix = 'askmovie' then
              (cbItem.Obj as TFrmChat).AddAskingAcception(aaMovie)
            else if Prefix = 'askvib' then
              (cbItem.Obj as TFrmChat).AddAskingAcception(aaVib)
            else if Prefix = 'movie_question_stopped' then
              (cbItem.Obj as TFrmChat).DelAskingAcception(aaMovie)
            else if Prefix = 'vib_question_stopped' then
              (cbItem.Obj as TFrmChat).DelAskingAcception(aaVib)
            else
              (cbItem.Obj as TFrmChat).NewInMessage(msg);
          end;
          {
          else if cbItem.Obj is TfrmMovie then
          begin
            if Prefix = 'askmovie' then
              (cbItem.Obj as TfrmMovie).AskForAcception(_UserID,_rmtNick)
            else
              (cbItem.Obj as TfrmMovie).NewInMessage(msg);
          end;
          }
          {
          else if cbItem.Obj is TVibFunction then begin
            if Prefix = 'askvib' then begin
            //  (cbItem.Obj as TfrmMovie).AskForAcception(_jid,_rmtNick)
            end else
              (cbItem.Obj as TVibFunction).NewInMessage(msg);
          end
          else if cbItem.Obj is TVibDistri then begin
            (cbItem.Obj as TVibDistri).NewInMessage(msg);
          end;
          }
        end;
        if n = _ObjList.Count then
          inc(i);       //Maybe it was a 'close' message which made a unregister. if not inc(i) else not
      end;
      if not found then
      begin
        if (Prefix <> 'movie') and
          (Prefix <> 'movie_question_stopped') and
          (Prefix <> 'vibtx') and
          (Prefix <> 'vib_question_stopped') and
          (Prefix <> 'vibrx')then begin  //these Windows should only be created after acceptance
          New(cbItem);
          cbItem.RXPrefix:=Prefix;
          cbItem.AcceptRemote := false;
          cbItem.Obj := nil;
          if (Prefix = 'chat') or (Prefix = '') then
          begin
            cbItem.Obj := TFrmChat.Create(nil); //(Application);
            TFrmChat(cbItem.Obj).Init(TravCore, Self, _UserID, _rmtNick, _MyName, aaNone, aaNone);
            TFrmChat(cbItem.Obj).NewInMessage(msg);
          end
          else if (Prefix = 'askmovie') then
          begin
            cbItem.RXPrefix := '';
            cbItem.Obj := TFrmChat.Create(nil); //(application)
            TFrmChat(cbItem.Obj).Init(TravCore, Self, _UserID, _rmtNick, _MyName, aaNone, aaMovie);
          end
          else if (Prefix = 'askvib') then
          begin
            cbItem.RXPrefix := '';
            cbItem.Obj := TFrmChat.Create(nil); //(application);
            TFrmChat(cbItem.Obj).Init(TravCore, Self, _UserID, _rmtNick, _MyName, aaNone, aaVib);
          end;
          cbItem.TXPrefix := cbItem.RXPrefix;
          _ObjList.Add(cbItem);
        end;
      end;
    end;
  finally
    stoken.Free;
  end;
end;

function TChatDistri.RegisterMsgCallBack(AcceptRemote: Boolean; RXPrefix, TXPrefix: string; Frm: TObject): TObject;
var
  cbItem: PRegCallBackItem;
  i: Integer;
begin
  New(cbItem);
  cbItem.RXPrefix := RXPrefix;
  cbItem.TXPrefix := TXPrefix;
  cbItem.AcceptRemote := AcceptRemote;
  cbItem.Obj := Frm;
  result := cbItem.Obj;
  _ObjList.Add(cbItem);
end;

function TChatDistri.NewChat: TForm;
var
  cbItem: PRegCallBackItem;
  i: Integer;
  chatfrm: TFrmChat;
begin
  i := SearchForRXPrefix('');
  if i = -1 then
    i := SearchForRXPrefix('chat');
  if (I = -1) then
  begin
    chatfrm := TFrmChat.Create(nil); //(application);
    chatfrm.Init(TravCore, Self, _UserID, _rmtNick, _MyName, aaNone, aaNone);
    result := RegisterMsgCallBack(true,'','',chatfrm) as TForm;
  end
  else
  begin
    cbItem := _ObjList[i];
    Result := cbItem.Obj as TForm;
  end;
end;

procedure TChatDistri.AskForPlayingVibViaChatWin;
var
  cbItem:PRegCallBackItem;
  i:integer;
  chatfrm:TFrmChat;
begin
  i := SearchForRXPrefix('');
  if i=-1 then
    i := SearchForRXPrefix('chat');
  if i>-1 then begin
    cbItem := _ObjList[i];
    if cbItem.Obj is TFrmChat then begin
      (cbItem.Obj as TFrmChat).AskForPlayingVib;
    end;
  end;
end;

function TChatDistri.NewMovie(AcceptRemote: Boolean): TForm;
var
  cbItem: PRegCallBackItem;
  i: Integer;
  //Form: TfrmMovie;
begin
  i := SearchForRXPrefix('movie');
  if (i = -1) then
  begin
    {
    Form := TfrmMovie.Create(nil);
    Form.Init(Self, GetRosterDB, _UserID, _rmtNick, False);
    Form.Show();
    Result := RegisterMsgCallBack(AcceptRemote, 'movie', 'movie', Form) as TForm;
    }
  end
  else
  begin
    cbItem := _ObjList[i];
    Result := cbItem.Obj as TForm;
  end;
end;

function TChatDistri.NewVibTX(AcceptRemote: Boolean): TObject;
var
  cbItem: PRegCallBackItem;
  ChatWin: TForm;
  i: Integer;
begin
  i := SearchForRXPrefix('vibtx');
  if (i = -1) then
  begin
    ChatWin := NewChat;
    {
    result := RegisterMsgCallBack(AcceptRemote,'vibtx','vibrx',TVibFunction.create(self,_UserID,_rmtNick,ChatWin));
    (result as TVibFunction).WinRegisteredInChatDistri;
    }
  end
  else
  begin
    cbItem := _ObjList[i];
    result := cbItem.Obj;
  end;
end;

procedure TChatDistri.VibAccepted;
begin
  NewVibTX(true);
end;

function TChatDistri.AskForPlayingVib(VibDistri: TObject): TObject;
var
  cbItem: PRegCallBackItem;
  i: Integer;
  ChatWin: TForm;
  s: string;
begin
  i := SearchForRXPrefix('vibrx');
  if (i = -1) then
  begin
    i := _ObjList.Count;
    New(cbItem);
    cbItem.AcceptRemote := false;
    cbItem.RXPrefix := 'vibrx';
    cbItem.TXPrefix := 'vibtx';
    if VibDistri <> nil then
      cbItem.Obj := VibDistri
    else
    begin
      ChatWin := NewChat;
      {
      cbItem.Obj := TVibDistri.create(self,VibHardWareDriver,ChatWin);
      }
    end;
    _ObjList.Add(cbItem);
  end
  else
  begin
    cbItem := _ObjList[i];
    if VibDistri <> nil then
      cbItem.Obj := VibDistri;
  end;
  SendMessage('{askvib}',nil);
  result := cbItem.Obj;
end;

function TChatDistri.isWaitingForVibRXAnswer: boolean;
var
  cbItem:PRegCallBackItem;
  i:integer;
  ChatWin:TForm;
  s:string;
begin
  i := SearchForRXPrefix('vibrx');
  if i>-1 then begin
    cbItem := _ObjList[i];
    result := not cbItem.AcceptRemote;
  end else
    result := false;
end;

procedure TChatDistri.VibDenied;
begin
  SendMessage('{vibrx}denied',nil);
end;

procedure TChatDistri.AskForWatchingMovie(MovieWin:TForm);
var
  cbItem:PRegCallBackItem;
  i:integer;
begin
  {
  i := SearchForRXPrefix('movie');
  if i=-1 then begin
    i := _ObjList.Count;
    New(cbItem);
    cbItem.AcceptRemote := false;
    cbItem.RXPrefix:='movie';
    cbItem.TXPrefix:='movie';
    if Assigned(MovieWin) then
      cbItem.Obj := MovieWin
    else
    begin
      cbItem.Obj := TfrmMovie.Create(nil);
      TfrmMovie(cbItem.Obj).Init(Self, GetRosterDB, _UserID, _rmtNick, True);
      TfrmMovie(cbItem.Obj).Show();
    end;
    _ObjList.Add(cbItem);
  end
  else
  begin
    cbItem := _ObjList[i];
    if Assigned(MovieWin) then
      cbItem.Obj := MovieWin;
  end;
  }
  SendMessage('{askmovie}',nil);
end;

procedure TChatDistri.MovieAccepted(MovieWin:TForm);
begin
  if MovieWin = nil then
    MovieWin := NewMovie(true);
  SendMessage('accepted',MovieWin);
end;

procedure TChatDistri.MovieDenied;
begin
  SendMessage('{movie}denied',nil);
end;

procedure TChatDistri.SetCryptState(CryptState: TCryptState);
var
  i:integer;
  cbItem:PRegCallBackItem;
begin
  self.CryptState := CryptState;
  for i := 0 to _ObjList.Count-1 do
  begin
    cbItem := _ObjList[i];
    if cbItem.Obj <> nil then
      if cbItem.Obj is TFrmChat then
        (cbItem.Obj as TFrmChat).SetCryptState(CryptState);
  end;
end;

function TChatDistri.GetCryptState: TCryptState;
begin
  result := CryptState;
end;

procedure TChatDistri.UnRegisterMsgCallback(Obj: TObject);
var
  i:integer;
  cbItem:PRegCallBackItem;
begin
  i := 0;
  while i< _ObjList.Count do
  begin
    cbItem := _ObjList[i];
    if (cbItem.Obj = Obj) or (cbItem.Obj = nil) then
    begin
      if (cbItem.Obj <> nil) then
      begin
        if cbItem.AcceptRemote = false then
        begin
          (*
          if Obj is TfrmMovie then
          begin
            SendMessage('{movie_question_stopped}',nil);
          end
          else if Obj is TVibDistri then begin
            SendMessage('{vib_question_stopped}',nil);
          end;
          *)
        end;
      end;
      Dispose(cbItem);
      _ObjList.Delete(i);
     // break;
    end else
      inc(i);
  end;
  if _ObjList.Count = 0 then begin
    if (InetCom is TNobraNet) then
      (InetCom as TNobraNet).closeChat(_UserID);
  end;
end;

procedure TChatDistri.SetAcceptRemote(AcceptRemote: boolean;Obj:TObject);
var
  i:integer;
  cbItem:PRegCallBackItem;
begin
  i := SearchForWin(Obj);
  if i > -1 then begin
    cbItem := _ObjList[i];
    cbItem.AcceptRemote := AcceptRemote;
  end;
end;

procedure TChatDistri.SendRawMessage(body, subject, xml: Widestring;
    fire_plugins: boolean; priority: PriorityType);
begin
    // send the msg
    // XXX: PGM: is this your trim?  What should we do with messages that
    // start with $#D, etc.?

  if Assigned(chat_object) then
    if not(TravCore.JabberObj.IsAppClosing) then
      chat_object.SendMsg(Trim(body),subject,xml,true, priority);
  if InetCom is TNobraNet then
    (InetCom as TNobraNet).sendMsg(_UserID,body);
    _check_event := true;
end;

function TChatDistri._sendMsg(txt: Widestring; xml: Widestring; priority: PriorityType): boolean;
begin
  sendRawMessage(txt,'',xml,true, priority);
  result := true;
end;

procedure TChatDistri.sendComposing(id,jid: Widestring);
begin
  if InetCom is Tjabber then
    (InetCom as Tjabber).sendComposing(id,jid);
end;

procedure TChatDistri.SendMessage(Msg:string;Sender:Tobject);
var
  txt: Widestring;
  xml: Widestring;
  Prefix:string;
  i:integer;
  cbItem:PRegCallBackItem;
begin
  Prefix := '';
  if Sender <> nil then
  begin
    for i := 0 to _ObjList.Count-1 do
    begin
      cbItem := _ObjList[i];
      if cbItem.Obj= sender then
      begin
        Prefix := cbItem.TXPrefix;
      end;
    end;
    if Prefix <> '' then
    Prefix := '{'+Prefix+'}';
    txt := Prefix+Msg;
  end
  else
    txt:= Msg;
  if InetCom is TNobraNet then
  begin
    txt := TranslateTravieToNobra(txt,_rmtNick);
  end;
  xml := '';
  if (txt <> '') then
  begin
    if Assigned(TravCore.CryptLayer) then
      txt := TravCore.CryptLayer.NewOutMessage(txt, Self);
    if (txt <> '') then
    begin
      if (_RosterDB.GetOwnContactData.status <> csOffline) then
        _SendMsg(txt, xml, None);
    end;
  end;
end;

function TChatDistri.GetThread(): WideString;
begin
  result := '';
  if Assigned(chat_object) then
    result := chat_object.GetThreadID();
end;

procedure TChatDistri.PlayQueue();
var
    t: TXMLTag;
begin
    // pull all of the msgs from the controller queue,
    // and feed them into this window
    if (chat_object = nil) then exit;

    while (chat_object.msg_queue.AtLeast(1)) do begin
        t := TXMLTag(chat_object.msg_queue.Pop());
        Self.MessageEvent(t);
    end;
end;

procedure TChatDistri.MessageEvent(tag: TXMLTag);
var
    xml, body: Widestring;
    msg_type, from_jid: WideString;
    etag, tagThread : TXMLTag;
begin
    if chat_object = nil then exit;
    // callback for messages
    // check for a jabber:x:event tag

    msg_type := tag.GetAttribute('type');
    from_jid := tag.getAttribute('from');


    //if from_jid <> jid then begin
       // chat_object.SetJID(from_jid);
     {   SetJID(from_jid);   }
   // end;

  {  if (msg_type = 'error') then begin
        showMsg(tag);
        exit;
    end; }

    if (_check_event) then begin
        // check for composing events
        etag := tag.QueryXPTag(XP_MSGXEVENT);
        if ((etag <> nil) and (etag.GetFirstTag('composing') <> nil))then begin
            // we got a composing a message
            if (etag.GetBasicText('id') = chat_object.LastMsgId) then begin
                _flash_ticks := 0;

                // Setup the cache'd old versions in ChangePresImage
//                _cur_img := _pres_img;
           //     MsgList.DisplayComposing('-- ' + DisplayName + _(' is replying --'));

                {
                should we really bail here??
                Gabber sends type=chat for msg events so it'll get into the
                next block of code anyways. If we don't bail,
                then we'll have to check to see if we have a body in the
                next block of code. ICK
                }

                exit;
            end;
            //else if (etag.GetFirstTag('id') <> nil) then //Got an empty id
                //MsgList.HideComposing();
        end;
    end;

    // process the msg
    etag := tag.QueryXPTag(XP_MSGCOMPOSING);
    _sent_composing := false;
    _send_composing := (etag <> nil);
    if (_send_composing) then
        _reply_id := tag.GetAttribute('id');

    // plugin
    xml := tag.xml();

    if tag.GetFirstTag('body')<>nil  then begin
      body := tag.GetBasicText('body');
      DistriMsg(body,not (tag.QueryXPTag(XP_MSGDELAY) = nil));
    end;
   { if (not com_controller.fireBeforeRecvMsg(body, xml)) then
        exit;   }



  //  showMsg(tag);
    if GetThread() = '' then begin
        //Get thread from message
        tagThread := tag.GetFirstTag('thread');
        if tagThread <> nil then begin
            chat_object.setThreadID(tagThread.Data);
        end;
   end;
   //did this message have an xhtml-im node?
    _receivedMessage := true;
    _receivedXIMNode := (tag.QueryXPTag(XP_XHTMLIM) <> nil);

 //  com_controller.fireAfterRecvMsg(body);
end;

{---------------------------------------}
//Handle outgoing messages
procedure TChatDistri.SendMessageEvent(tag: TXMLTag);
var
  send_allowed: boolean;
  body: Widestring;
  xml: Widestring;
  ttag: TXMLTag;
  newTag: TXMLTag;
  _MainSession :TJabberSession;
begin
  if InetCom is TJabber then begin
    _MainSession := (InetCom as TJabber).GetSession;
    send_allowed := true;
    body := tag.GetBasicText('body');

    if (tag.QueryXPTag(XP_MSGDELAY) = nil) then begin
    //If not a delayed message (previously sent), send and then display

 //   if (com_controller <> nil) then //Do plugin before message logic
 //     send_allowed := com_controller.fireBeforeMsg(body);

      if (send_allowed) then begin
      // SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-
        xml := '';
      // SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-SIG-
   //   if (com_controller <> nil) then //Do plugin after message logic
   //     xml := com_controller.fireAfterMsg(body);

        if (xml <> '') then
          tag.addInsertedXml(xml);

      //plaugins have had their shot, make a new message tag from the old,
      //so extra xml will actually exist as tags.
        newTag := reparseTag(tag);
      //showMsg(newTag);

      //remove xhtml-im elements if needed now that the message has been shown.
      {ttag := newTag.QueryXPTag(XP_XHTMLIM);
      if (ttag <> nil) then begin
        if (isToXIMEnabled(newTag)) then
            newTag.AddTag(CleanXIMTag(tTag, false, true)); //clean any proprietary styles before sending
        newTag.RemoveTag(ttag);
      end;         }
       _MainSession.SendTag(TXMLTag.create(newTag));
        newTag.Free();
      end;
    end
    else begin
    // This is a delayed message.
    // It was already sent, but not displayed because we were paused.
    // This is a rare situation, but possible.
    //showMsg(tag);
    end;
  end else begin
  end;

end;



{function TChatDistri.isToXIMEnabled(tag: TXMLTag): boolean;
var
    e: TJabberEntity;
    toStr: WideString;
    toJID: TJabberID;
    _MainSession:TJabberSession;
begin
  if InetCom is TJabber then begin
    _MainSession := (InetCom as Tjabber).GetSession;
    Result := false;
    if (_MainSession.Prefs.getBool('richtext_enabled')) then begin
        Result := _receivedXIMNode or (not _receivedMessage);
        toStr := tag.GetAttribute('to');
        if (toStr = '') then exit;
        toJID := TJabberID.Create(toStr);
        e := getBestCapsEntity(toJID);
        if (e <> nil) then begin
            if (e.hasFeature(XMLNS_XHTMLIM)) then begin
                _supportsXIM := true;
                Result := true;
            end
            else if (_supportsXIM) then begin
                Result := false;
                _supportsXIM := false;
                _receivedXIMNode := false; //keep us from sending anythign else
            end;
        end
    end;
  end else
    result := false;
end;
       }


function TChatDistri.GetRosterDB: TRosterDB;
begin
  result := _RosterDB;
end;


procedure TChatDistri.NewIncomingChatMsg(Msg: string);
begin
  DistriMsg(msg,false);
end;

function TChatDistri.GetNetType: TNetType;
begin
  if InetCom is TNobraNet then
    result := ntNobraNet
  else if InetCom is Tjabber then
    result := ntJabber
  else
    result := ntAll;
end;

function TChatDistri.GetRmtNick: string;
begin
  result := _rmtNick;
end;

procedure TChatDistri.ProtocollIsReadyForTransferMsgs();
begin
  if not(ProtocollIsReady) and Assigned(TravCore.CryptLayer) then
    TravCore.CryptLayer.RegisterChatDistri(self, Initiator);
  ProtocollIsReady := True;
end;

function TChatDistri.PartnerCanEncryption: Boolean;
var
  Ent: TJabberEntity;
  Version: TVersion;
begin
  result := true;
  if InetCom is TNobraNet then
  begin
    Result := isTravieUserAtNobra(_rmtNick);
  end;
  if InetCom is Tjabber then
  begin
    ent := jEntityCache.getByJid(_userID);
    result := ent = nil;
    if not result then
      result := ent.hasFeature(FEAT_TRAVIESADORA_ENC);
    if not result then
    begin
      version := ent.Version;
      if Version = nil then
        result := true
      else
      begin
        result := Version.AppName=PrefController.getAppInfo.ID;
      end;
    end;
  end;
end;

function TChatDistri.PartnerIsOnline: boolean;
var
  ent:TJabberEntity;
  version:TVersion;
  cd:TContactData;
begin
  result := true;
  if InetCom is TNobraNet then begin
    result := true;
  end;
  if InetCom is Tjabber then begin
    cd := _RosterDB.GetPresenceByJID(_userID);
    result := cd.status <> csOffline;
  end;
end;

function TChatDistri.GetUserID: string;
begin
  result := _UserID;
end;

function TChatDistri.GetUserIDwoPortNum: string;
begin
  if GetNetType = ntJabber then
    result := _UserID
  else if GetNetType = ntNobraNet then begin
  //  delete(result,pos(':',result),length(result));
    result := GetRmtNick;
  end;
end;

procedure TChatDistri.SetToWantedCrypt(CryptState: TCryptState);
begin
  if Assigned(TravCore.CryptLayer) then
    TravCore.CryptLayer.SetToWantedCrypt(CryptState,self);
end;

end.
